home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Tutorial Material / Zone Tutorial / Structure Examples / 5. Struct3 < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  99 lines
  1. ;  STRUCT3 - structure study  (expanded to 4 parts)
  2.  
  3. (setq sonal (activate-tonality (pentatonic c 6) (blues1 f 6)))
  4. (setq tonal (activate-tonality (dorian c 4) (pentatonic b& 3)))
  5. (setq chords (activate-tonality (c min 7 1 4) (d& maj maj7 1 4)))
  6.  
  7. (setq solo1 (gen-random-keep 0.45 8 '(1 7) '(= a a a a a = a) '(b c d e)))
  8. (setq solo2 (find-change (vector-to-symbol a g (gen-noise-white 30))))
  9.  
  10. (setq mel1 '(a b c d)) ; bass 
  11. (setq mel2 '(a d b c))
  12.  
  13. (setq drms1 '(ah h dh ah h h dh i)) ; hi-hat, snare, bass drum
  14. (setq drms2 '(h ch ch ah ah ic h ha)) ;  hi-hat, rimshot, bass drum
  15.  
  16. (setq chd1 '(bcde)) ; keyboard
  17. (setq chd2 '(a cd bde))
  18.  
  19. ; Nigel has been using tick value 96 for 1/4 note. 
  20. ; Because Nigel often mixes ticks and ratios, the function must take
  21. ; both cases into account.
  22.  
  23. (defun use-nigel-ticks (l)
  24.   (let (out)
  25.     (dolist (x l)
  26.       (if (is-length-symbol x)
  27.         (push x out)
  28.         (push (* x 5) out)))
  29.     (nreverse out)))
  30.  
  31. (setq rhy1 (use-nigel-ticks (gen-loop '((1 4 2) (5 6 4) (1 6 3)) '(24 24 24 24 48 48))))
  32. (setq rhy2 (use-nigel-ticks (gen-fibonacci 5 '(24 24 48) '(96 24 24 48))))
  33. (setq rhyc (use-nigel-ticks (list (* 24 8)(* 48 8) 192 192 192)))
  34. (setq rhyd (use-nigel-ticks (gen-fibonacci 5 '(24 -24 48) '(24 48 24 96))))
  35.  
  36. (setq mel1a (fill-template rhy1 mel1))
  37. (setq mel2a (fill-template rhy2  mel2))
  38. (setq drms1a (fill-template rhy1 drms1))
  39. (setq drms2a (fill-template rhy2 drms2))
  40. (setq solo1a (fill-template rhy1 solo1))
  41. (setq solo2a (fill-template rhy2 solo2))
  42. (setq chds1 (fill-template rhyc chd1))
  43. (setq chds2 (fill-template rhyd chd2))
  44.  
  45. (setq zone1 (list (make-zone rhy1)))
  46. (setq zone2 (list (make-zone rhy2)))
  47.  
  48. (setq vel1 (fill-template rhy1 '(74 54 84 74 54 54 84 44)))
  49. (setq vel2 (fill-template rhy2 '(64 94 127 84 74 84 64 117)))
  50.  
  51. (setq zones (append zone1 zone2 zone1))
  52. (setq rhys (append rhy1 rhy2 rhy1))
  53. (setq mels (append mel1a mel2a mel1a))
  54. (setq chs (append chds1 chds2 chds1))
  55. (setq solox (append solo1a solo2a solo1a))
  56. (setq rhyds (append rhyc rhyd rhyc))
  57. (setq drmsx (append drms1a drms2a drms1a))
  58. (setq vels (append vel1 vel2 vel1))
  59.  
  60. (def-symbol
  61.    solo solox
  62.    bass mels
  63.    pno chs
  64.    drums drmsx
  65. )
  66.  
  67. (def-length
  68.    solo rhys
  69.    bass rhys
  70.    pno rhyds
  71.    drums rhys
  72. )
  73.  
  74. (def-velocity
  75.    drums vels
  76. )
  77.  
  78. (def-zone
  79.    solo zones
  80.    bass zones
  81.    pno zones
  82.    drums zones
  83. )
  84.  
  85. (def-tonality
  86.    solo sonal
  87.    bass tonal
  88.    pno chords
  89.    drums mt-32
  90. )
  91.  
  92. (compile-instrument-p "ccl;output:" "quartet"
  93.    solo
  94.    bass
  95.    pno
  96.    drums
  97. )
  98.  
  99.